home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / comcof.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  7KB  |  253 lines
  1. /* comcof.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  26.         sfactr;
  27.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  28.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  29. } status_;
  30.  
  31. #define status_1 status_
  32.  
  33. struct {
  34.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  35.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  36. } flags_;
  37.  
  38. #define flags_1 flags_
  39.  
  40. struct {
  41.     doublereal value[200000];
  42. } blank_;
  43.  
  44. #define blank_1 blank_
  45.  
  46. /*<       subroutine comcof >*/
  47. /* Subroutine */ int comcof_()
  48. {
  49.     /* System generated locals */
  50.     integer i_1, i_2, i_3;
  51.  
  52.     /* Local variables */
  53.     static doublereal gmat[49]    /* was [7][7] */;
  54.     extern /* Subroutine */ int zero8_();
  55.     static integer i, j, k, istop, ir;
  56. #define nodplc ((integer *)&blank_1)
  57. #define cvalue ((complex *)&blank_1)
  58.     static integer jstart;
  59.     static doublereal arg, arg1;
  60.  
  61. /*<       implicit double precision (a-h,o-z) >*/
  62.  
  63. /*     this routine calculates the timestep-dependent terms used in the */
  64.  
  65. /* numerical integration. */
  66.  
  67. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  68. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  69. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  70. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  71. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  72. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  73. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  74. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  75. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  76. /* spice version 2g.6  sccsid=status 3/15/83 */
  77. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  78. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  79. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  80. /* spice version 2g.6  sccsid=flags 3/15/83 */
  81. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  82. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  83. /* spice version 2g.6  sccsid=blank 3/15/83 */
  84. /*<       common /blank/ value(200000) >*/
  85. /*<       integer nodplc(64) >*/
  86. /*<       complex cvalue(32) >*/
  87. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  88. /*<       dimension gmat(7,7) >*/
  89.  
  90. /*  compute coefficients for particular integration method */
  91.  
  92. /*<       if (method.ne.1) go to 5 >*/
  93.     if (status_1.method != 1) {
  94.     goto L5;
  95.     }
  96. /*<       if (iord.eq.1) go to 5 >*/
  97.     if (status_1.iord == 1) {
  98.     goto L5;
  99.     }
  100. /* ...  trapezoidal method */
  101. /*<       ag(1)=1.0d0/delta/(1.0d0-xmu) >*/
  102.     status_1.ag[0] = 1. / status_1.delta / (1. - status_1.xmu);
  103. /*<       ag(2)=xmu/(1.0d0-xmu) >*/
  104.     status_1.ag[1] = status_1.xmu / (1. - status_1.xmu);
  105. /*<       go to 200 >*/
  106.     goto L200;
  107.  
  108. /*  construct gear coefficient matrix */
  109.  
  110. /*<     5 istop=iord+1 >*/
  111. L5:
  112.     istop = status_1.iord + 1;
  113. /*<       call zero8(ag,istop) >*/
  114.     zero8_(status_1.ag, &istop);
  115. /*<       ag(2)=-1.0d0 >*/
  116.     status_1.ag[1] = -1.;
  117. /*<       do 10 i=1,istop >*/
  118.     i_1 = istop;
  119.     for (i = 1; i <= i_1; ++i) {
  120. /*<       gmat(1,i)=1.0d0 >*/
  121.     gmat[i * 7 - 7] = 1.;
  122. /*<    10 continue >*/
  123. /* L10: */
  124.     }
  125. /*<       do 20 i=2,istop >*/
  126.     i_1 = istop;
  127.     for (i = 2; i <= i_1; ++i) {
  128. /*<       gmat(i,1)=0.0d0 >*/
  129.     gmat[i - 1] = 0.;
  130. /*<    20 continue >*/
  131. /* L20: */
  132.     }
  133. /*<       arg=0.0d0 >*/
  134.     arg = 0.;
  135. /*<       do 40 i=2,istop >*/
  136.     i_1 = istop;
  137.     for (i = 2; i <= i_1; ++i) {
  138. /*<       arg=arg+delold(i-1) >*/
  139.     arg += status_1.delold[i - 2];
  140. /*<       arg1=1.0d0 >*/
  141.     arg1 = 1.;
  142. /*<       do 30 j=2,istop >*/
  143.     i_2 = istop;
  144.     for (j = 2; j <= i_2; ++j) {
  145. /*<       arg1=arg1*arg >*/
  146.         arg1 *= arg;
  147. /*<       gmat(j,i)=arg1 >*/
  148.         gmat[j + i * 7 - 8] = arg1;
  149. /*<    30 continue >*/
  150. /* L30: */
  151.     }
  152. /*<    40 continue >*/
  153. /* L40: */
  154.     }
  155.  
  156. /*  solve for gear coefficients ag(*) */
  157.  
  158.  
  159. /*  lu decomposition */
  160.  
  161. /*<       do 70 i=2,istop >*/
  162.     i_1 = istop;
  163.     for (i = 2; i <= i_1; ++i) {
  164. /*<       jstart=i+1 >*/
  165.     jstart = i + 1;
  166. /*<       if (jstart.gt.istop) go to 70 >*/
  167.     if (jstart > istop) {
  168.         goto L70;
  169.     }
  170. /*<       do 60 j=jstart,istop >*/
  171.     i_2 = istop;
  172.     for (j = jstart; j <= i_2; ++j) {
  173. /*<       gmat(j,i)=gmat(j,i)/gmat(i,i) >*/
  174.         gmat[j + i * 7 - 8] /= gmat[i + i * 7 - 8];
  175. /*<       do 50 k=jstart,istop >*/
  176.         i_3 = istop;
  177.         for (k = jstart; k <= i_3; ++k) {
  178. /*<       gmat(j,k)=gmat(j,k)-gmat(j,i)*gmat(i,k) >*/
  179.         gmat[j + k * 7 - 8] -= gmat[j + i * 7 - 8] * gmat[i + k * 7 - 
  180.             8];
  181. /*<    50 continue >*/
  182. /* L50: */
  183.         }
  184. /*<    60 continue >*/
  185. /* L60: */
  186.     }
  187. /*<    70 continue >*/
  188. L70:
  189.     ;}
  190.  
  191. /*  forward substitution */
  192.  
  193. /*<       do 90 i=2,istop >*/
  194.     i_1 = istop;
  195.     for (i = 2; i <= i_1; ++i) {
  196. /*<       jstart=i+1 >*/
  197.     jstart = i + 1;
  198. /*<       if (jstart.gt.istop) go to 90 >*/
  199.     if (jstart > istop) {
  200.         goto L90;
  201.     }
  202. /*<       do 80 j=jstart,istop >*/
  203.     i_2 = istop;
  204.     for (j = jstart; j <= i_2; ++j) {
  205. /*<       ag(j)=ag(j)-gmat(j,i)*ag(i) >*/
  206.         status_1.ag[j - 1] -= gmat[j + i * 7 - 8] * status_1.ag[i - 1];
  207. /*<    80 continue >*/
  208. /* L80: */
  209.     }
  210. /*<    90 continue >*/
  211. L90:
  212.     ;}
  213.  
  214. /*  backward substitution */
  215.  
  216. /*<       ag(istop)=ag(istop)/gmat(istop,istop) >*/
  217.     status_1.ag[istop - 1] /= gmat[istop + istop * 7 - 8];
  218. /*<       ir=istop >*/
  219.     ir = istop;
  220. /*<       do 110 i=2,istop >*/
  221.     i_1 = istop;
  222.     for (i = 2; i <= i_1; ++i) {
  223. /*<       jstart=ir >*/
  224.     jstart = ir;
  225. /*<       ir=ir-1 >*/
  226.     --ir;
  227. /*<       do 100 j=jstart,istop >*/
  228.     i_2 = istop;
  229.     for (j = jstart; j <= i_2; ++j) {
  230. /*<       ag(ir)=ag(ir)-gmat(ir,j)*ag(j) >*/
  231.         status_1.ag[ir - 1] -= gmat[ir + j * 7 - 8] * status_1.ag[j - 1];
  232. /*<   100 continue >*/
  233. /* L100: */
  234.     }
  235. /*<       ag(ir)=ag(ir)/gmat(ir,ir) >*/
  236.     status_1.ag[ir - 1] /= gmat[ir + ir * 7 - 8];
  237. /*<   110 continue >*/
  238. /* L110: */
  239.     }
  240.  
  241. /*  finished */
  242.  
  243. /*<   200 return >*/
  244. L200:
  245.     return 0;
  246. /*<       end >*/
  247. } /* comcof_ */
  248.  
  249. #undef cvalue
  250. #undef nodplc
  251.  
  252.  
  253.